home *** CD-ROM | disk | FTP | other *** search
- /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
-
- /*
- $Header: b2syn.c,v 1.4 85/08/22 16:56:25 timo Exp $
- */
-
- #include "b.h"
- #include "b0con.h"
- #include "b1obj.h"
- #include "b2key.h"
- #include "b2syn.h"
- #include "b3scr.h"
- #include "b3env.h"
- #include "b3err.h"
-
- #define TABSIZE 8 /* Number of spaces assumed for a tab on a file.
- (Some editors insist on emitting tabs wherever
- they can, and always assume 8 spaces for a tab.
- Even when the editor can be instructed not to
- do this, beginning users won't know about this,
- so we'll always assume the default tab size.
- Advanced users who used to instruct their editor
- to set tab stops every 4 spaces will have to
- unlearn this habit. But that's the price for
- over-cleverness :-)
- The indent increment is still 4 spaces!
- When the B interpreter outputs text, it never uses
- tabs but always emits 4 spaces for each indent level.
- Note that the B editor also has a #defined constant
- which sets the number of spaces for a tab on a file.
- Finally the B editor *displays* indents as 3 spaces,
- but *writes* them to the file as 4, so a neat
- lay-out on the screen may look a bit garbled
- when the file is printed. Sorry. */
-
- Visible txptr tx, ceol;
-
- Visible Procedure skipsp(tx) txptr *tx; {
- while(Space(Char(*tx))) (*tx)++;
- }
-
- Visible bool keymark(c) char c; {
- return Cap(c) || Dig(c) || c=='\'' || c=='"';
- }
-
- Hidden bool tagmark(c) char c; {
- return Letter(c) || Dig(c) || c=='\'' || c=='"';
- }
-
- Hidden bool keytagmark(c) char c; {
- return keymark(c) || Letter(c);
- }
-
- Visible bool is_expr(c) char c; {
- return Letter(c) || c == '(' || Dig(c) || c == '.' ||
- c == '\'' || c == '"' || c == '{' ||
- c=='~' ||
- c=='*' || c=='/' || c=='+' || c=='-' || c=='#';
- }
-
- /* ******************************************************************** */
- /* cr_text */
- /* ******************************************************************** */
-
- Visible value cr_text(p, q) txptr p, q; {
- /* Messes with the input line, which is a bit nasty,
- but considered preferable to copying to a separate buffer */
- value t;
- char save= Char(q);
- Char(q)= '\0';
- t= mk_text(p);
- Char(q)= save;
- return t;
- }
-
- /* ******************************************************************** */
- /* find, findceol, req, findrel */
- /* ******************************************************************** */
-
- #define Ptr (*ftx)
- #define Nokeymark '+'
-
- Hidden bool E_number(tx) txptr tx; {
- return Char(tx) == 'E' && Dig(Char(tx+1)) &&
- (Dig(Char(tx-1)) || Char(tx-1) == '.');
- }
-
- Hidden bool search(find_kw, s, q, ftx, ttx)
- bool find_kw; string s; txptr q, *ftx, *ttx; {
-
- intlet parcnt= 0; bool outs= Yes, kw= No; char aq, lc= Nokeymark;
- while (Ptr < q) {
- if (outs) {
- if (parcnt == 0) {
- if (find_kw) {
- if (Cap(Char(Ptr)) && !E_number(Ptr))
- return Yes;
- } else if (Char(Ptr) == *s) {
- string t= s+1;
- *ttx= Ptr+1;
- while (*t && *ttx < q) {
- if (*t != Char(*ttx)) break;
- else { t++; (*ttx)++; }
- }
- if (*t);
- else if (Cap(*s) &&
- (kw || keymark(Char(*ttx))));
- else return Yes;
- }
- }
- switch (Char(Ptr)) {
- case '(': case '{': case '[':
- parcnt++; break;
- case ')': case '}': case ']':
- if (parcnt > 0) parcnt--; break;
- case '\'': case '"':
- if (!keytagmark(lc)) {
- outs= No; aq= Char(Ptr);
- }
- break;
- default:
- break;
- }
- lc= Char(Ptr); kw= kw ? keymark(lc) : Cap(lc);
- } else {
- if (Char(Ptr) == aq)
- { outs= Yes; kw= No; lc= Nokeymark; }
- else if (Char(Ptr) == '`') {
- Ptr++;
- if (!search(No, "`", q, &Ptr, ttx)) return No;
- }
- }
- Ptr++;
- }
- return No;
- }
-
- /* ******************************************************************** */
-
- Visible bool find(s, q, ftx, ttx) string s; txptr q, *ftx, *ttx; {
- return search(No, s, q, (*ftx= tx, ftx), ttx);
- }
-
- Forward txptr lcol();
-
- Visible Procedure findceol() {
- txptr q= lcol(), ttx;
- if (!find("\\", q, &ceol, &ttx)) ceol= q;
- }
-
- Visible Procedure req(s, q, ftx, ttx) string s; txptr q, *ftx, *ttx; {
- if (!find(s, q, ftx, ttx)) {
- parerr2(MESS(2400, "cannot find expected "), MESSMAKE(s));
- *ftx= tx; *ttx= q;
- }
- }
-
- Hidden bool relsearch(s, q, ftx) string s; txptr q, *ftx; {
- txptr ttx;
- Ptr= tx;
- while (search(No, s, q, &Ptr, &ttx))
- switch (Char(Ptr)) {
- case '<': if (Char(Ptr+1) == '<') Ptr= ++ttx;
- else if (Char(Ptr-1) == '>') Ptr= ttx;
- else return Yes;
- break;
- case '>': if (Char(Ptr+1) == '<') Ptr= ++ttx;
- else if (Char(Ptr+1) == '>') Ptr= ++ttx;
- else return Yes;
- break;
- case '=': return Yes;
- default: return No;
- }
- return No;
- }
-
- Visible bool findrel(q, ftx) txptr q, *ftx; {
- txptr ttx;
- Ptr= q;
- if (relsearch("<", Ptr, &ttx)) Ptr= ttx;
- if (relsearch(">", Ptr, &ttx)) Ptr= ttx;
- if (relsearch("=", Ptr, &ttx)) Ptr= ttx;
- return Ptr < q;
- }
-
- /* ******************************************************************** */
- /* tag, keyword, findkw */
- /* ******************************************************************** */
-
- Visible bool is_tag(v) value *v; {
- if (!Letter(Char(tx))) return No;
- *v= tag();
- return Yes;
- }
-
- Visible value tag() {
- txptr tx0= tx;
- if (!Letter(Char(tx))) parerr(MESS(2401, "no tag where expected"));
- while (tagmark(Char(tx))) tx++;
- return cr_text(tx0, tx);
- }
-
- Visible bool is_keyword(v) value *v; {
- if (!Cap(Char(tx))) return No;
- *v= keyword();
- return Yes;
- }
-
- Visible value keyword() {
- txptr tx0= tx;
- if (!Cap(Char(tx))) parerr(MESS(2402, "no keyword where expected"));
- while (keymark(Char(tx))) tx++;
- return cr_text(tx0, tx);
- }
-
- Visible bool findkw(q, ftx) txptr q, *ftx; {
- txptr ttx;
- Ptr= tx;
- return search(Yes, "", q, &Ptr, &ttx);
- }
-
- /* ******************************************************************** */
- /* upto, nothing, ateol, atkw, need */
- /* ******************************************************************** */
-
- Visible Procedure upto(q, s) txptr q; string s; {
- skipsp(&tx);
- if (Text(q)) {
- parerr2(MESS(2403, "something unexpected following "),
- MESSMAKE(s));
- tx= q;
- }
- }
-
- Visible bool nothing(q, s) txptr q; string s; {
- if (!Text(q)) {
- if (Char(tx-1) == ' ') tx--;
- parerr2(MESS(2404, "nothing instead of expected "),
- MESSMAKE(s));
- return Yes;
- }
- return No;
- }
-
- Hidden bool looked_ahead= No;
- Visible intlet cur_ilev;
-
- Visible bool ateol() {
- if (looked_ahead) return Yes;
- skipsp(&tx);
- return Eol(tx);
- }
-
- Visible bool atkw(s) string s; {
- txptr tx0= tx;
- while (*s) if (*s++ != Char(tx0++)) return No;
- if (keymark(Char(tx0))) return No;
- tx= tx0;
- return Yes;
- }
-
- Visible Procedure need(s) string s; {
- string t= s;
- skipsp(&tx);
- while (*t)
- if (*t++ != Char(tx++)) {
- tx--;
- parerr2(MESS(2405, "according to the syntax I expected "),
- MESSMAKE(s));
- return;
- }
- }
-
- /* ******************************************************************** */
- /* buffer handling */
- /* ******************************************************************** */
-
- Visible txptr first_col;
-
- Visible txptr fcol() { /* the first position of the current line */
- return first_col;
- }
-
- Hidden txptr lcol() { /* the position beyond the last character of the line */
- txptr ax= tx;
- while (!Eol(ax)) ax++;
- return ax;
- }
-
- Visible intlet ilev() {
- intlet i;
- if (looked_ahead) {
- looked_ahead= No;
- return cur_ilev;
- } else {
- first_col= tx= getline();
- looked_ahead= No;
- lino++;
- f_lino++;
- i= 0;
- while (Space(Char(tx)))
- if (Char(tx++) == ' ') i++;
- else i= (i/TABSIZE+1)*TABSIZE;
- if (Char(tx) == '\\') return cur_ilev= 0;
- if (Char(tx) == '\n') return cur_ilev= 0;
- if (i%4 == 2)
- parerr(MESS(2406, "cannot make out indentation; use tab to indent"));
- return cur_ilev= (i+1)/4; /* small deviation accepted */
- }
- }
-
- Visible Procedure veli() { /* After a look-ahead call of ilev */
- looked_ahead= Yes;
- }
-
- Visible Procedure first_ilev() { /* initialise read buffer for new input */
- looked_ahead= No;
- VOID ilev();
- findceol();
- }
-
- /* ******************************************************************** */
-
- /* The reserved keywords that a user command may not begin with: */
-
- Visible value kwlist;
-
- Hidden string kwtab[] = {
- K_SHARE, K_CHECK, K_CHOOSE, K_DELETE, K_DRAW, K_FAIL, K_FOR,
- K_HOW_TO, K_IF, K_INSERT, K_PUT, K_QUIT, K_READ, K_REMOVE,
- K_REPORT, K_RETURN, K_SELECT, K_SET_RANDOM, K_SUCCEED,
- K_TEST, K_WHILE, K_WRITE, K_YIELD, K_ELSE,
- ""
- };
-
- Visible Procedure initsyn() {
- value v;
- string *kw;
- kwlist= mk_elt();
- for (kw= kwtab; **kw != '\0'; kw++) {
- insert(v= mk_text(*kw), &kwlist);
- release(v);
- }
- }
-
- Visible Procedure endsyn() {
- release(kwlist); kwlist= Vnil;
- }
-
- /* ******************************************************************** */
- /* signs */
- /* ******************************************************************** */
-
- Visible string textsign;
-
- Hidden bool la_denum(tx0) txptr tx0; {
- char l, r;
- switch (l= Char(++tx0)) {
- case '/': r= '*'; break;
- case '*': r= '/'; break;
- default: return Yes;
- }
- do if (Char(++tx0) != r) return No; while (Char(++tx0) == l);
- return Yes;
- }
-
- #ifdef NOT_USED
- Visible bool colon_sign() {
- return Char(tx) == ':' ? (tx++, Yes) : No;
- }
- #endif
-
- Visible bool comment_sign() {
- return Char(tx) == '\\' ? (tx++, Yes) : No;
- }
-
- Visible bool nwl_sign() {
- return Char(tx) == '/' && !la_denum(tx-1) ? (tx++, Yes) : No;
- }
-
- Visible bool open_sign() {
- return Char(tx) == '(' ? (tx++, Yes) : No;
- }
-
- #ifdef NOT_USED
- Visible bool close_sign() {
- return Char(tx) == ')' ? (tx++, Yes) : No;
- }
- #endif
-
- #ifdef NOT_USED
- Visible bool comma_sign() {
- return Char(tx) == ',' ? (tx++, Yes) : No;
- }
- #endif
-
- Visible bool point_sign() {
- return Char(tx) == '.' ? (tx++, Yes) : No;
- }
-
- Visible bool apostrophe_sign() {
- return Char(tx) == '\'' ? (tx++, textsign= "'", Yes) : No;
- }
-
- Visible bool quote_sign() {
- return Char(tx) == '"' ? (tx++, textsign= "\"", Yes) : No;
- }
-
- Visible bool conv_sign() {
- return Char(tx) == '`' ? (tx++, Yes) : No;
- }
-
- Visible bool curlyopen_sign() {
- return Char(tx) == '{' ? (tx++, Yes) : No;
- }
-
- Visible bool curlyclose_sign() {
- return Char(tx) == '}' ? (tx++, Yes) : No;
- }
-
- Visible bool sub_sign() {
- return Char(tx) == '[' ? (tx++, Yes) : No;
- }
-
- #ifdef NOT_USED
- Visible bool bus_sign() {
- return Char(tx) == ']' ? (tx++, Yes) : No;
- }
- #endif
-
- Visible bool behead_sign() {
- return Char(tx) == '@' ? (tx++, textsign= "@", Yes) : No;
- }
-
- Visible bool curtl_sign() {
- return Char(tx) == '|' ? (tx++, textsign= "|", Yes) : No;
- }
-
- Visible bool about_sign() {
- return Char(tx) == '~' ? (tx++, textsign= "~", Yes) : No;
- }
-
- Visible bool plus_sign() {
- return Char(tx) == '+' ? (tx++, textsign= "+", Yes) : No;
- }
-
- Visible bool minus_sign() {
- return Char(tx) == '-' ? (tx++, textsign= "-", Yes) : No;
- }
-
- Visible bool times_sign() {
- return Char(tx) == '*' && la_denum(tx)
- ? (tx++, textsign= "*", Yes) : No;
- }
-
- Visible bool over_sign() {
- return Char(tx) == '/' && la_denum(tx)
- ? (tx++, textsign= "/", Yes) : No;
- }
-
- Visible bool power_sign() {
- return Char(tx) == '*' && Char(tx+1) == '*' && la_denum(tx+1)
- ? (tx+= 2, textsign= "**", Yes) : No;
- }
-
- Visible bool numtor_sign() {
- return Char(tx) == '*' && Char(tx+1) == '/' && la_denum(tx+1)
- ? (tx+= 2, textsign= "*/", Yes) : No;
- }
-
- Visible bool denomtor_sign() {
- return Char(tx) == '/' && Char(tx+1) == '*' && la_denum(tx+1)
- ? (tx+= 2, textsign= "/*", Yes) : No;
- }
-
- Visible bool join_sign() {
- return Char(tx) == '^' && Char(tx+1) != '^'
- ? (tx++, textsign= "^", Yes) : No;
- }
-
- Visible bool reptext_sign() {
- return Char(tx) == '^' && Char(tx+1) == '^'
- ? (tx+= 2, textsign= "^^", Yes) : No;
- }
-
- Visible bool leftadj_sign() {
- return Char(tx) == '<' && Char(tx+1) == '<'
- ? (tx+= 2, textsign= "<<", Yes) : No;
- }
-
- Visible bool center_sign() {
- return Char(tx) == '>' && Char(tx+1) == '<'
- ? (tx+= 2, textsign= "><", Yes) : No;
- }
-
- Visible bool rightadj_sign() {
- return Char(tx) == '>' && Char(tx+1) == '>'
- ? (tx+= 2, textsign= ">>", Yes) : No;
- }
-
- Visible bool number_sign() {
- return Char(tx) == '#' ? (tx++, textsign= "#", Yes) : No;
- }
-
- Visible bool less_than_sign() {
- return Char(tx) == '<' && Char(tx+1) != '=' &&
- Char(tx+1) != '>' && Char(tx+1) != '<'
- ? (tx++, Yes) : No;
- }
-
- Visible bool at_most_sign() {
- return Char(tx) == '<' && Char(tx+1) == '=' ? (tx+= 2, Yes) : No;
- }
-
- Visible bool equals_sign() {
- return Char(tx) == '=' ? (tx++, Yes) : No;
- }
-
- Visible bool unequal_sign() {
- return Char(tx) == '<' && Char(tx+1) == '>' ? (tx+= 2, Yes) : No;
- }
-
- Visible bool at_least_sign() {
- return Char(tx) == '>' && Char(tx+1) == '=' ? (tx+= 2, Yes) : No;
- }
-
- Visible bool greater_than_sign() {
- return Char(tx) == '>' && Char(tx+1) != '='
- && Char(tx+1) != '>' && Char(tx+1) != '<'
- ? (tx++, Yes) : No;
- }
-
- Visible bool dyamon_sign() {
- return plus_sign() || minus_sign() || number_sign();
- }
-
- Visible bool dya_sign() {
- return times_sign() || over_sign() || power_sign() ||
- join_sign() || reptext_sign() ||
- leftadj_sign() || center_sign() || rightadj_sign();
- }
-
- Visible bool mon_sign() {
- return about_sign() || numtor_sign() || denomtor_sign();
- }
-
- Visible bool trim_sign() {
- return behead_sign() || curtl_sign();
- }
-
- Visible bool check_keyword() { return atkw(K_CHECK); }
- Visible bool choose_keyword() { return atkw(K_CHOOSE); }
- Visible bool delete_keyword() { return atkw(K_DELETE); }
- Visible bool draw_keyword() { return atkw(K_DRAW); }
- Visible bool insert_keyword() { return atkw(K_INSERT); }
- Visible bool put_keyword() { return atkw(K_PUT); }
- Visible bool read_keyword() { return atkw(K_READ); }
- Visible bool remove_keyword() { return atkw(K_REMOVE); }
- Visible bool setrandom_keyword() { return atkw(K_SET_RANDOM); }
- Visible bool write_keyword() { return atkw(K_WRITE); }
- Visible bool fail_keyword() { return atkw(K_FAIL); }
- Visible bool quit_keyword() { return atkw(K_QUIT); }
- Visible bool return_keyword() { return atkw(K_RETURN); }
- Visible bool report_keyword() { return atkw(K_REPORT); }
- Visible bool succeed_keyword() { return atkw(K_SUCCEED); }
- Visible bool if_keyword() { return atkw(K_IF); }
- Visible bool select_keyword() { return atkw(K_SELECT); }
- Visible bool while_keyword() { return atkw(K_WHILE); }
- Visible bool for_keyword() { return atkw(K_FOR); }
- Visible bool else_keyword() { return atkw(K_ELSE); }
- #ifdef NOT_USED
- Visible bool and_keyword() { return atkw(K_AND); }
- Visible bool or_keyword() { return atkw(K_OR); }
- #endif
- Visible bool not_keyword() { return atkw(K_NOT); }
- Visible bool some_keyword() { return atkw(K_SOME); }
- Visible bool each_keyword() { return atkw(K_EACH); }
- Visible bool no_keyword() { return atkw(K_NO); }
- Visible bool how_to_keyword() { return atkw(K_HOW_TO); }
- Visible bool yield_keyword() { return atkw(K_YIELD); }
- Visible bool test_keyword() { return atkw(K_TEST); }
- Visible bool share_keyword() { return atkw(K_SHARE); }
-